home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / drift.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  1.6 KB  |  53 lines
  1. 100 REM PROGRAM FOR GENETIC DRIFT
  2. 120 OPTION BASE 1
  3. 130 CLS:PRINT : CLEAR : GEN=1
  4. 135 RANDOMIZE: PRINT
  5. 140 INPUT "ENTER THE SIZE OF THE POPULATION";N%
  6. 150 PRINT
  7. 160 INPUT "ENTER THE SURVIVORSHIP PERCENTAGE (1 TO 100)";TP
  8. 170 SP=TP/100
  9. 190 DIM POP(N%+2)
  10. 200 FOR I=1 TO N%/2
  11. 210 POP(I)=0: NEXT
  12. 220 FOR I=(N%/2+1) TO N%
  13. 230 POP(I)=1:NEXT
  14. 240 PRINT: PRINT "                  GENERATION ";GEN:PRINT
  15. 250 GOSUB 900 'PRINT OUT POP. STRUCTURE
  16. 260 PICK%=SP*N% 'FIGURE # TO SURVIVE
  17. 270 SUMS=0:SUMT=0 'W-0, B-1
  18. 280 FOR I=1 TO PICK% 'LOOP TO CHOOSE SURVIVORS
  19. 290 REM KEEP COUNT OF TALLS AND SHORTS
  20. 300 IF POP(INT(RND(1)*N%)) THEN SUMT=SUMT + 1 ELSE SUMS=SUMS + 1
  21. 310 NEXT
  22. 320 'SET NEXT GENERATION
  23. 330 FOR I=1 TO INT(SUMS/SP)
  24. 340 POP(I)=0: NEXT
  25. 350 FOR I=INT(SUMS/SP)+1 TO N%
  26. 360 POP(I)=1: NEXT
  27. 365 IF INT(SUMS/SP)>N% THEN SUMS=N%/SP
  28. 370 ' PRINT OUT RESULTS
  29. 372 GEN=GEN+1
  30. 375 PRINT: PRINT"                  GENERATION";GEN
  31. 380 PRINT: PRINT INT(SUMS/SP);"SHORT INDIVIDUALS       ";
  32. 390 PRINT N%-INT(SUMS/SP);" TALL INDIVIDUALS"
  33. 450 PRINT:GOSUB 900 'DISPLAY RESULTS
  34. 460 IF SUMT=0 OR SUMS=0 THEN GOTO 500 ELSE GOTO 270
  35. 500 PRINT:PRINT: PRINT "!!!!!  HOMOZYGOUS FOR ONE GENE  !!!!": PRINT: PRINT
  36. 505 PRINT "TYPE Y TO TRY ANOTHER RUN"
  37. 510 A$=INKEY$: IF A$="" THEN 510 ELSE 520
  38. 520 IF A$="Y" OR A$="y" THEN 130 ELSE END
  39. 900 '  DISPLAY SUBROUTINE
  40. 910 FOR I= 1 TO N%
  41. 920 IF POP(I)=0 THEN PRINT CHR$(1);:GOTO 940
  42. 930 IF POP(I)=1 THEN GOTO 950
  43. 940 NEXT
  44. 950 PRINT: PRINT
  45. 960 FOR J=I TO N%
  46. 970 PRINT CHR$(2);
  47. 980 NEXT: PRINT
  48. 990 FOR Z=1 TO 500: NEXT Z 'PAUSE FOR NEXT GENERATION
  49. 1000 RETURN
  50. T
  51. 960 FOR J=I TO N%
  52. 970 PRINT CHR$(2);
  53. 980 NEX